C---------------------------------------------------------
C    TOOLPACK/1    Release: 1.1
C---------------------------------------------------------
C
C  TABTST - 21 MAR 84
C           TIE TABLES SUPPLEMENTARY LIBRARY
C           TEST PROGRAM
C
C  THIS PROGRAM IS PROVIDED AS A MEANS OF TESTING THE FUNCTIONS
C  PROVIDED IN THE TABLES SUPPLEMENTARY LIBRARY AND AS A MEANS
C  OF GIVING EXAMPLE USES OF SOME OF THE ROUTINES.
C
      PROGRAM TABTST
 
      INTEGER            SIZE, POINTR, JUNK
      PARAMETER (SIZE=1000)
      INTEGER            STRING(134), TABLE(SIZE), TREE(SIZE),
     +                   DATA(2)
      INTEGER            ZTBINT, ZBTINT, ZTBACC, ZBTRST, ZBTNXT
      EXTERNAL           ZINIT, ZQUIT, ERROR, ZMESS, ZIMPLS, SKIP,
     +                   ZTBINT, ZBTINT, ZTBACC, ZBTRST, ZBTNXT
 
      CALL ZINIT
      CALL ZMESS('TABLES TEST PROGRAM.', 1)
      CALL ZIMPLS(STRING)
      CALL ZPTMES(STRING, 1)
      CALL SKIP(1)
      CALL ZMESS('TEST OF TABLES AND BINARY TREES...', 1)
C
C  SET UP A TABLE AND THEN ASK THE USER TO ENTER STRINGS INTO IT
C  IN RANDOM ORDER.
C
      IF(ZTBINT(TABLE, SIZE, 2) .EQ. -1) CALL ERROR(
     +                          'UNABLE TO SET UP TABLE.')
      CALL GTWORD(TABLE)
C
C  NOW ENTER THE TABLE KEYS INTO A BINARY TREE USING IT TO
C  PERFORM A MONKEY PUZZLE SORT INTO LEXICAL ORDER.
C
      IF(ZBTINT(TREE, SIZE, 1, 1) .EQ. -1) CALL ERROR(
     +                          'UNABLE TO SET UP TREE.')
      CALL SORT(TABLE, TREE)
C
C  AN INORDER TRAVERSAL OF THE TREE WILL NOW YIELD THE STRINGS
C  IN LEXICAL ORDER
C
      CALL ZMESS('YOUR STRINGS, IN LEXICAL ORDER, ARE:.',1)
      IF(ZBTRST(TREE) .EQ. -1) CALL ERROR('NOT A TREE.')
 
   10 CONTINUE
      IF(ZBTNXT(POINTR, TREE) .EQ. -100) GO TO 999
      IF(ZTBACC(POINTR, STRING, JUNK, DATA, TABLE) .EQ. -1)
     +  CALL ERROR('INVALID TABLE ENTRY RECOVERY ATTEMPTED.')
      CALL ZPTMES(STRING, 1)
      GO TO 10
 
 999  CONTINUE
      CALL ZQUIT(-2)
      END
C------------------------------------------------------------------
C
C  SORT   - 21 MAR 84
C           TABTST
C
C  SORT TABLE KEYS INTO LEXICAL ORDER
C  THIS IS A MONKEY PUZZLE SORT, EACH NODE OF THE BINARY TREE
C  WILL END UP CONTAINING A POINTER INTO THE TABLE FOR THE
C  APPROPRIATE STRING.
C
      SUBROUTINE SORT(TABLE, TREE)
 
      INTEGER  ENTRYS, JUNK, POINT, CMPPNT, STATUS, DIR
      INTEGER  TABLE(*), TREE(*), STRING(134), COMPAR(134),
     +         DATA(2)
      INTEGER  ZORDER, ZTBTYP, ZTBACC, ZBTADD, ZBTBRA, ZBTTOP
      EXTERNAL ZORDER, ZTBTYP, ZTBACC, ZBTADD, ZBTBRA, ZBTTOP
 
C  FIND OUT HOW MANY TABLE ENTRIES THERE ARE TO BE SORTED
      IF(ZTBTYP(TABLE, JUNK, ENTRYS, JUNK, JUNK) .EQ. -1) CALL
     +   ERROR('ARRAY IS NOT A TABLE.')
 
 
C  LOOP AROUND ENTERING EACH STRING INTO THE TREE. THIS DO LOOP
C  COULD START AT 2 AS THE FIRST ELEMENT HAS ALREADY BEEN PUT
C  INTO THE ROOT NODE DURING INITIALISATION.
      DO 10 POINT = 1, ENTRYS
 
C       GET THE STRING TO BE INSERTED
        IF(ZTBACC(POINT, STRING, JUNK, DATA, TABLE) .EQ. -1)
     +    CALL ERROR('ARRAY IS NOT A TABLE.')
 
C       GO BACK TO THE ROOT AND TRY TO FIND WHERE TO ADD THE NEW
C       STRING. DIR CONTAINS THE FREE SIBLING POSITION INFORMATION
C       FOR THE CURRENT NODE.
        DIR =  ZBTTOP(CMPPNT, TREE)
 
C       THIS INNER LOOP IS EXECUTED REPEATEDLY COMPARING THE NEW
C       STRING WITH THE STRING STORED IN THE CURRENT NODE. IF
C       THE STRINGS ARE EQUAL NO ENTRY IS MADE. IF THE NEW STRING
C       IS GREATER THAN THE STORED STRING TRY TO ADD THE NEW
C       STRING AS A RIGHT SIBLING, IF THE NEW STRING IS LESS THAN
C       THE STORED STRING TRY TO ADD IT AS A LEFT SIBLING. IF IT
C       IS NOT POSSIBLE TO ADD THE NEW STRING (BECAUSE THE REQUIRED
C       SIBLING POINTER IS NOT FREE, THEN MOVE ON TO THE NEXT
C       NODE (TO THE LEFT OR RIGHT AS APPROPRIATE) AND START AGAIN.
C       NOTE THAT STRINGS ARE NOT ACTUALLY STORED IN THE TREE, THE
C       TREE ONLY CONTAINS POINTERS INTO THE TABLE.
C
   20   CONTINUE
        IF(DIR .EQ. -1) CALL ERROR('ARRAY IS NOT A TREE.')
        IF(ZTBACC(CMPPNT, COMPAR, JUNK, DATA, TABLE) .EQ. -1)
     +    CALL ERROR('ARRAY IS NOT A TABLE.')
 
        STATUS = ZORDER(STRING, COMPAR)
        IF(STATUS .EQ. 61) GO TO 10
 
        IF(STATUS .EQ. 60) THEN
          IF((DIR .EQ. 114) .OR. (DIR .EQ. 102)) THEN
            DIR = ZBTBRA(108, CMPPNT, TREE)
            GO TO 20
          ENDIF
          IF(ZBTADD(108, POINT, TREE) .NE. -2) CALL
     +       ERROR('UNABLE TO ADD TO TREE.')
 
        ELSE
          IF((DIR .EQ. 108) .OR. (DIR .EQ. 102)) THEN
            DIR = ZBTBRA(114, CMPPNT, TREE)
            GO TO 20
          ENDIF
          IF(ZBTADD(114, POINT, TREE) .NE. -2) CALL
     +       ERROR('UNABLE TO ADD TO TREE.')
 
        ENDIF
   10 CONTINUE
 
      RETURN
      END
C------------------------------------------------------------------
C
C  GTWORD - 21 MAR 84
C           TABTST
C
C  GET THE WORDS TO BE ENTERED INTO THE TABLE
C
      SUBROUTINE GTWORD(TABLE)
 
      INTEGER  JUNK, ENTRYS, FREE, SIZE
      INTEGER  TABLE(*), DATA(2), STRING(134)
      INTEGER  ZGTCMD, ZTBPUT, ZTBTYP
      EXTERNAL ERROR, ZGTCMD, ZTBPUT, ZMESS, ZTBTYP
 
C  GET STRINGS FROM THE USER AND ENTER THEM INTO THE TABLE,
C  DO NOT ENTER THE SAME WORD MORE THAN ONCE. EACH WORD
C  IS TREATED AS A TABLE ENTRY KEY, THERE ARE TWO DATA
C  VALUES CURRENTLY ASSOCIATED WITH EACH KEY, THE FIRST
C  EQUALS THE STRING LENGTH.
 
      DATA(2) = 0
 
   10 CONTINUE
 
        CALL ZMESS('ENTER WORD FOR THE TABLE:.', 1)
        IF(ZTBTYP(TABLE, JUNK, ENTRYS, FREE, JUNK) .EQ. -1) CALL
     +     ERROR('ARRAY IS NOT A TABLE.')
 
        SIZE = ZGTCMD(STRING, 0)
        DATA(1) = SIZE
        IF((SIZE .EQ.0) .OR. (SIZE .EQ. -100)) GO TO 999
        SIZE = SIZE + 1
        IF(ZTBPUT(STRING, SIZE, DATA, TABLE) .EQ. -100) THEN
          CALL ZMESS('TABLE IS TOO FULL.', 1)
          GO TO 999
        ENDIF
 
      GO TO 10
 
  999 CONTINUE
      IF(ENTRYS .EQ. 0) CALL ERROR('NO ENTRIES MADE.')
      CALL PUTDEC(ENTRYS, 1)
      CALL ZMESS(' UNIQUE ENTRIES MADE.', 1)
 
      RETURN
      END
 
